home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio / Ham Radio CD-ROM (Emerald Software) (1995).ISO / bbs / savemail / savemail.pas < prev   
Pascal/Delphi Source File  |  1988-03-14  |  2KB  |  98 lines
  1.  
  2. program Savemail;
  3. uses Dos;
  4.  
  5. {$I Savefile}
  6.  
  7. var
  8.    Name,
  9.    NamR   : string[12];
  10.    Save_Path,
  11.    Path   : string;
  12.    SRec   : SearchRec;
  13.    Wc      : integer;
  14.  
  15. procedure PutLead(I : integer);
  16.  
  17. begin
  18.    if I >= 10
  19.       then Write(I:2)
  20.       else Write('0',I:1)
  21. end;          { of procedure PutLead }
  22.  
  23. procedure PutDateTime(DT : DateTime);
  24. var
  25.    H   : Integer;
  26.    Ch  : char;
  27.  
  28. begin
  29.    with DT do begin
  30.       Write(Month:2,'-');
  31.       PutLead(Day); Write('-');
  32.       PutLead(Year mod 100); Write('  ');
  33.       if Hour >= 12
  34.          then Ch := 'p'
  35.          else Ch := 'a';
  36.       H := Hour mod 12;
  37.       if H = 0
  38.          then H := 12;
  39.       Write(H:2,':');
  40.       PutLead(Min); Write(Ch)
  41.    end
  42. end;               { of procedure PutDateTime }
  43.  
  44. procedure PutName(Name : string);
  45. var
  46.    DotPos  : integer;
  47.    Ext     : string[3];
  48.  
  49. begin
  50.    NamR := Name;
  51.    DotPos := Pos('.',Name);
  52.    if DotPos <> 0 then begin
  53.       Ext := Copy(Name,DotPos+1,Length(Name)-DotPos);
  54.       Delete(Name,DotPos,1+Length(Name)-DotPos)
  55.    end
  56.    else Ext := '';
  57.    Write(Name,' ':(10-Length(Name)),Ext,' ':(5-Length(Ext)))
  58. end;         { of procedure PutName }
  59.  
  60.  
  61.  
  62. procedure PutSRec(SRec : SearchRec);
  63.  
  64. var
  65.    DT : DateTime;
  66. begin
  67.    with SRec do begin
  68.       PutName(Name);
  69.       if (Attr and Directory) <> 0
  70.          then Write('   <DIR>')
  71.       else begin
  72.          Write(Size:10,'   ');
  73.          UnpackTime(Time,DT);
  74.          PutDateTime(DT)
  75.       end;
  76.       WriteLn
  77.    end
  78. end;              { of procedure PutSRec }
  79.  
  80. begin
  81.    Wc := 0;
  82.    repeat
  83.       Write('Enter path name: '); Readln(Path);
  84.       Write('Enter path for saved files: ');ReadLn(Save_Path);
  85.       Writeln('Screening ',Path,' -- Copying to ',Save_Path);
  86.       If Path <> '' then begin
  87.          FindFirst(Path,AnyFile,SRec);
  88.          while DosError = 0 do begin
  89.             PutSRec(SRec);
  90.             FindNext(SRec);
  91.             SaveFile(NamR,Save_Path,Wc)
  92.          end;
  93.          WriteLn
  94.       end
  95.    until Path = '';
  96.    WriteLn(' The number of Weather Messages was ', Wc)
  97. end.    { of program Savemail }
  98.